perm filename T2.F4[M11,LCS]5 blob
sn#426302 filedate 1979-03-15 generic text, type T, neo UTF8
C THIS ROUTINE FINDS KEY WORDS IN I ARRAY AND PUTS THEIR KEY NUMS
C INTO THE IX ARRAY. IX ARRAY ADVANCES 2 WORDS AT A TIME.
C IF 2ND WRD OF EACH PAIR IS NON-ZERO THEN 1ST IS FLT. PT. NUM.
C KCNT IS WORD COUNT OF INPUT STRING.
SUBROUTINE MPACK(KCNT, I,IX,IPTR)
INTEGER FQDR
COMMON/IGEN/IGEN /FQDR/FQDR(28,27),INSN
CIN COMMON /TR/Q(80),QX(100),IIX(100),LX(12),INST(27,4),K
COMMON /TR/LX(12),K
DIMENSION I(1),WDS(18)
COMMON /WDZ/WDZ(14),JWD(12)
DATA WDS/'OUT','OSC','AD2','RAN','ENV','STR','AD3','AD4',
1 'MLT','DIV','RAH','END','REV','OPT','NOS','SUB','INP','COS'/,
1 WDZ/'PLAY','FINI','SRAT','NCHN','PRIN','CHA','POWE','SRT',
1 'WORD','GEN','SEG','SIN','INS','UNIT'/,
1 JWD/'C','D','E','F','G','A','B','P','*','/',0,0/
DATA IPP/'P'/,IFF/'F'/,IBB/'B'/,ISS/'S'/,
1 IDD/'D'/,I2/'2'/,I3/'3'/,I4/'4'/,I0/'0'/,I9/'9'/,IPP/'P'/
IX=I(1)
101 N=I(2)
L=I(3)
CALL PACKER(RNAM,I)
C NOW RNAM HAS PACKED WORD
IF(IGEN.NE.2)GO TO 1000
C IGEN=2=READING INSTRUMENT DEFINITION
CODE NUMS ARE 1-13 FOR UNIT GENS., 100+ FOR B, 200+ FOR P, 300+ FOR F.
C ORD. OF UNIT GENS:OUT,OSC,AD2,RAN,ENV,STR,AD3,AD4,MLT,DIV,RAH,END,REV
C OPT,NOS,SUB,INP,COS
C OPT=OPTIONAL, NOS=OSC WHICH ACCEPTS NEG. FREQ., COS=CONTINUING NOS.
IF(IX.EQ.IPP)GO TO 14
IF(IX.EQ.IFF)GO TO 15
IF(IX.EQ.IBB)GO TO 16
IF(IX.EQ.IDD)GO TO 142
C FPN = FREQ. PARAM. NUM. DPN = DUR. PARAM. NUM.
DO 102 IX=1,18
102 IF(RNAM.EQ.WDS(IX))RETURN
C SENDS BACK NUM FOR 1 TO 17
C IF NOT A KNOWN WORD THEN ERROR
999 IF(IGEN.EQ.2)GO TO 28
C SO INST NAME CAN START WITH 'P' (BUT NO 'P12X', ETC.)
CALL ERR(5)
141 JCVT=-1
GO TO 143
142 JCVT=1
143 N=L
L=I(4)
C SHIFT POINTER 1 TO RIGHT
KCNT=KCNT-1
GO TO 144
14 JCVT=0
144 J=200
C PN
18 IF(N.LT.I0.OR.N.GT.I9)GO TO 999
K2=0
K1=NASCI(N)
C CONVERTS ASCII CHAR. TO INTEGER
IF(KCNT.EQ.2)GO TO 19
C ARE THERE 2 DIGITS AFTER P, F OR B?
IF(L.LT.I0.OR.L.GT.I9)GO TO 999
K1=K1*10
K2=NASCI(L)
19 IX=J+K1+K2
IF(JCVT.EQ.0)RETURN
C NOW SET UP A FREQ OR DUR FLAG
FQDR(K1+K2-2,INSN)=JCVT
JCVT=0
RETURN
15 IF(N.EQ.IPP)GO TO 141
C JUMP FOR 'FP' = FREQ PARAM
J=300
C FN
GO TO 18
16 J=100
C BN
GO TO 18
C NEXT FOR OTHER (MUS10 TYPE) KEY WORDS.
1000 IF(KCNT.LT.3)GO TO 2000
C JUMP TO FIND NOTE NAMES, PARAMS, FUNCTS.
DO 1 K=1,15
IF(RNAM.NE.WDZ(K))GO TO 1
C THIS LIST BEGINS WITH CODE NUM. 400:
C PLAY,FINI,SRATE,NCHNS,PRINT,CHA,POWER,SRT,END,GEN,DUR,FREQ,INS,UNIT GEN
IX=K+399
RETURN
1 CONTINUE
IF(IX.EQ.IPP)GO TO 14
C CHECK FOR A PARAM NUM OR INST. NAME
28 IX=-IPTR
C SEND BACK NEG. POINTER TO I ARRAY SO IT WILL LOOK FOR INST. NAME.
RETURN
2000 DO 2 K=1,12
C FINDS (P1, P21, ETC.)
2 IF(IX.EQ.JWD(K))GO TO(5,11,7,4,6,8,9,14,15,16)K
GO TO 28
C A FUNC??
4 IF(N.GE.I0.AND.N.LE.I9)GO TO 15
IF(KCNT.EQ.3)GO TO 28
IX=510
GO TO 36
5 IX=501
C 'C'
C AT THIS POINT NOTE NUMBERS RUN FROM 500 TO 520 (CF TO BS)
GO TO 36
6 IX=513
C THE NOTE 'G'
36 IF(KCNT.EQ.1)RETURN
IF(N.EQ.IFF)GO TO 39
IF(N.NE.ISS) GO TO 28
C NOW IT'S NOT A NOTE
40 IX=IX+1
C SHARP
RETURN
39 IX=IX-1
C FLAT
RETURN
11 IX=504
C 'D'
GO TO 36
7 IF(KCNT.EQ.3)GO TO 4
C 'END' OR NOTE 'E'?
IX=507
GO TO 36
8 IX=516
GO TO 36
9 IX=519
GO TO 36
END
SUBROUTINE ERR(N)
COMMON /NDEV/NDEV
GO TO (1,2,3,4,5)N
1 WRITE(NDEV,101)
STOP
101 FORMAT(' MISSING SEMICOLON')
2 WRITE(NDEV,102)
STOP
102 FORMAT(' MISSING PARENTHESIS')
3 WRITE(NDEV,103)
STOP
103 FORMAT(' MISSING COMMA')
4 WRITE(NDEV,104)
104 FORMAT(' MISSING PLAY;')
5 WRITE(NDEV,105)
105 FORMAT(' UNKNOWN WORD')
STOP
END
SUBROUTINE ARITH(Y,W,LL)
DIMENSION W(1)
COMMON /AR/IOP
7 X=W(LL-1)
GO TO (1,2,3,4,5),IOP
1 IF(Y.EQ.0)Y=16.
C 0 WILL ALWAYS TURN INTO 16 WITH MULT OR DIV.
X=X*Y
GO TO 6
2 IF(Y.EQ.0)Y=16.
X=X/Y
GO TO 6
3 X=X-Y
GO TO 6
4 X=X+Y
GO TO 6
5 X=X**Y
6 W(LL-1)=X
END
SUBROUTINE PACKER(NAM,INP)
DATA IBLA/' '/,ISEMI/';'/,IARO/"575004020100/,IEQU/'='/
C****** THE BIG NUMBER=LEFT ARROW
C11 DOUBLE PRECISION NAM
DIMENSION INP(1),KNM(5)
DATA KK/128/,LL/"377777777777/,JJ/"2000000000/
1 , MM/"774000000000/
NAM=0
DO 1 J=1,80
N=INP(J)
IF(N.EQ.IARO.OR.N.EQ.IEQU)GO TO 2
1 IF(N.EQ.IBLA.OR.N.EQ.ISEMI)GO TO 2
2 II=J
J=J-1
N=J
IF(J.GT.4)N=4
4 DO 10 K=1,4
IF(K.GT.N)GO TO 11
KNM(K)=INP(K)
GO TO 10
11 KNM(K)=IBLA
10 CONTINUE
KNM(5)=IBLA
C ABOVE FOR PDP10 ONLY*********
C N=WDCNT
DO 12 K=5,1,-1
NAM=NAM .OR. (KNM(K) .AND. MM)
IF (K.EQ.1)RETURN
17 IF (NAM.GE.0)GO TO 13
NAM = (( NAM .AND. LL)/KK) .OR. JJ
GO TO 12
13 NAM = NAM / KK
12 CONTINUE
END